VYCUC: /* Tato procedûra vytahuje program a ukádá je do souboru. */
Parse Arg Cislo
C_Cas=TIME(S)
/* Demo */
IF Existuje=0 Then Do
say ''
SAY 'Reùim ªVycucºD'
DO FOR 16 ; Call Delay(1) ; Writech(STDOUT,'@') ; END ; Writech(STDOUT,'C')
DO FOR 4
Call Delay 10
Writech(STDOUT,'VycucºD') ; Call Delay(4)
Writech(STDOUT,'VycucºD')
END
Say '' ; Call Delay 20 ; Say ''
Call Delay 25
End
IF cislo='' Then DO until okEnd=1
/* Výbër programu */
IF Existuje = 1 THEN DO
cislo=rtgetstring(,'>>> Vycucnutí programu <<<'NL'Máte k dispozici 'P_ZUP' základních a 'P_DUP' doplnëné.'NL'Zadejte ç. programu (Pêed doplñené dejte ªDº)','Výzva','_OK|_Ukonçi program','rtgs_flags=gsreqf_centertext',OK)
End
ELSE DO
SAY ' Máte k dispozici 'P_ZUP' základních a 'P_DUP' doplñkové programy ! '
IF Existuje=1 Then IF rtezrequest('Ùádný program nechcete? Îkoda, ale jiù nic nemohu dëlat.') = 0 Then Exit 0 ; Else NOP
Else Do; Say 'Ùádný program nechcete? Îkoda, ale jiù nic nemohu dëlat...' ; Call Konec() ; End
/* Kontrola */
Cislo=Compress(Upper(Cislo))
okEnd=1 /* Pokud tato promënná zûstane zachována skonçí cyklus dotazu*/
IF Verify(cislo,'0123456789D')>0 & Verify(cislo,'123456789',M)=0 Then DO
IF Existuje = 1 Then OK = rtezrequest('Chybné,zadání!'NL'Opakovat?','_ANO|_NE','Upozornëní!','rtgs_flags=gsreqf_centertext rtgs_flags=gsreqf_highlighttext')
IF POS(cislo,obsah)>0 Then DO;Cas_A=Time(R);Call VyberS();Zap=1;Call Time(R);END
END
Call CLose(OUT)
Cas_B = Time(E) ; C_Cas= Time(S) - C_cas
IF ZAP=0 Then DO
IF Existuje=0 Then DO
Say ' Bylo zadáno neexistující çíslo programu !'
Say ' Zopakujte vstup !'
End
Call Znovu_V
END
/* Závërné statistiky */
IF Existuje=1 Then DO;NL='0A'x ;TP='';SP='';ZP='';END
Else DO;NL='E';TP='';SP='';ZP='';END
Text = ' 'SP'Hotovo,'ZP' program je vycucnut a uloùen do souboru.'NL' 'TP'Informace o ' C_cas's çinnosti programu:'ZP''NL' Ças vyhledávání:' Cas_A's Ças ukládání:' Cas_B's'NL' 'TP'Informace o uloùeném souboru:'ZP''NL' Poçet êádkû:' pocet'+2 Poçet znakû:' Pznak||NL
IF Existuje=1 Then Call RTezrequest(Text||NL' Poloha souboru: ª'soubor'º','OK','Výsledky')
ELSE DO
Say ''
Say Text
Call END()
END
Exit 0
VyberS:
Parse Value Compress(obsah) With . '/*'nazev'*/' ; nazev=nazev'.rexx'
IF Existuje=1 Then DO
soubor = rtfilerequest(path,nazev,'Vyber soubor!','Pokraçuj')
IF soubor='' Then Exit 0
IF Exists(soubor) Then DO
Pozice=LastPos('/',Translate(soubor,'/',':'))+1 ; Parse var soubor cesta =pozice nazev
vysledek = rtgetstring(nazev,'Soubor s tímto názvem jiù existuje!'NL'Mûùete zadaním nového jména soubor zachovat.'NL||NL'Pûvodní název: ª'nazev'º','Výzva','Pokraçuj','rtgs_flags=gsreqf_centertext')
IF vysledek~='' Then DO;Parse Var vysledek pred'.'.;Soubor=cesta||pred'.rexx';End
END
END
Else DO
SAY ''
SAY ' Stisknete-li jen ENTER bude zadáno: ª'path||nazev'º'
SAY ' Pokud nezadáte za název alespoñ teçku, bude vstup brán'
SAY ' jako cesta do adresáêe (zaêízení), kde se má uloùit soubor'
SAY ' s pûvodním jménem ª'nazev'º.'
DO P=0 Until Spravne=1 ; Spravne=1 /* Promënná "Spravne" nesmí být zmënëna, protoùe jinak je smyçka opakována */
Options prompt ' Zadejte cestu (a název) pro uloùení programu: '
Parse PULL soubor
/* Pokud uùivatel nic nezadá bude program uloùen do implicitního souboru. */
IF soubor='' Then DO;Soubor = Path||nazev;OKC=1;END
/* Rozklad na cestu a název. */
IF Pos('.',soubor)>0 Then DO;Pozice=LastPos('/',Translate(soubor,'/',':'))+1 ; Parse var soubor cesta =pozice nazevB;End
Else Do;cesta=soubor;nazevb=nazev;End
/* IF ~Exists(cesta) Then DO; Say ' Zadaný adresáê neexistuje !!!'; iterate; End */
IF nazevB='' Then DO;nazevb=nazev;soubor=cesta;End
soubor = cesta||bnazev
/* Zmëna jména pêi existenci souboru se stejným jménem. */
IF Exists(soubor) Then DO
Say ''
SAY ' Soubor s tímto názvem jiù existuje !'
SAY ' (Pokud chcete pûvodní soubor ztratit, stisknëte ENTER.)'
Options Prompt ' Zadejte nové jméno pro ª'nazevB'º: ' ; Parse PULL NazevB
IF NazevB='' Then Do; Say ' Jak chceî, soubor bude pêepsán.'; Call Delay 50 ; End
Else DO ; Parse Var Nazev pred'.'. ; Nazev=pred'.rexx' ; END
END
IF OKC=1 Then NOP /* Pokud cestu zadával uùivatel, bude provedena kontrola, jinak bude následující çást pêeskoçena. */
Else DO
/* Kontrola vstupu - existence adresáêe , název souboru */
IF POS(':',soubor)=0 Then DO
Say ' Takový nesmysl neberu, cesta musí zaçínat názvem zaêízení !'
Spravne=0 ; Iterate P
END
IF Pos('.',nazevB) > 0 Then Do
Parse var nazevB pred'.' . ; Nazev=pred'.rexx'
End
Else cesta=soubor
IF ~Exists(cesta) Then DO
say ' Adresáê ª'cesta'º neexistuje !'
/* Pokud vlastníte programový balík, na jehoù vývoji pracuji, mûùe být adresáê vytvoêen. */
NC_exists = ShowList('A','NC') ; vsuvka=' '
IF NC_exists=1 Then DO
Options Prompt ' Chcete jej vytvoêit (Ano/Ne): ' ; Pull OK
IF Odpoved(OK)=1 Then DO;Call 'nc:Arexx_scripty/MakeDir.rexx' cesta; IF result>0 Then NC_exists=0; End
Else DO;NC_exists=0;vsuvka=' tedy ';END
END
IF NC_exists=0 Then DO
Options prompt ' Chcete se'vsuvka'opravit? (Ano/Ne): ' ; Pull OK
IF Odpoved(OK)=1 Then Spravne=0
Else Call END('Tak mi nezbývá nic jiného, neù se s vámi rozlouçit.')
END
END
END
K = Right(cesta,1) ; IF K=':' | K='/' Then vsuvka='' ; Else vsuvka='/' ; soubor = cesta||vsuvka||nazev
END
Say ''
Say ' Program se ukládá do souboru: 'soubor''
END
parse source . . source .
IF ~Open(OUT,soubor,W) Then DO; say ' Nelze otevêít soubor pro zápis!';Exit 10;End
Tiskni(' Tento program slouùí pêedevîím k interaktivnímu spouîtëní¶ ukázkových programû pêímo z Arexx manuálu.¶',3,50)
Tiskni('¶ Jeho moùnosti jsou vîak dalekosáhlejîí. Umí totiù tyto¶ programy také uloùit do souboru k vaîemu bliùîímu¶ prozkoumaní nebo experimentování.¶',3,50)
Tiskni('¶ Plnë lze tento program vyuùít pêímo z manuálu.',3,15)
IF Existuje=0 Then DO ; Tiskni(', ale ¶ kdyù si poêídíte knihovnu ªRexxReqTools.libraryº umoùním¶ vám to, co vám nyní umoùnit nemohu.',4,40) ; Exit 0 ; END
Tiskni(', ale ¶ vzhledem k tomu, ùe jste îtastným majitelem knihovny¶ ª*2mRexxReqTools.library*0mº, umoùním vám nëco jiù nyní...',4,40)
Tiskni('¶¶ *1mTato správa jiù nebude nikdy vypsána. !!!¶',,50)
